unit ujsfuns;

interface

uses windows, sysutils;
{
http://mxr.mozilla.org/seamonkey/source/js/src/jsstr.c
}

function Escape(const StrEscape: string): string;
function UnEscape(const strUnEscape: string): string;
function EncodeURI(const Str:string):String;
function DecodeURI(const Str:string):String;
function EncodeURIComponent(const str:string):string;
function DecodeURIComponent(const str:string):string;


implementation

uses usysutils;

const
  URL_XALPHAS       = 1;                                    //the alphas
  URL_XPALPHAS      = 2;                                    //as xalpha but converts spaces to plus and plus to %20
  URL_PATH          = 4;                                    //as xalphas but doesn't escape '/'

  HexString         : pchar = '0123456789ABCDEF';

  UrlCharType       : array[0..128] of byte =
    (0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
    0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
    0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 7, 4, 0, 7, 7, 4,
    7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 0, 0, 0, 0, 0, 0,
    7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7,
    7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 0, 0, 0, 0, 7,
    0, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7,
    7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 0, 0, 0, 0, 0,
    0);

  js_uriReservedPlusPound_ucstr = [';', '/', '?', ':', '@', '&', '=', '+', '$', ',', '#'];

  js_uriUnescaped_ucstr =
    ['0', '1', '2', '3', '4', '5', '6', '7', '8', '9',
    'A', 'B', 'C', 'D', 'E', 'F', 'G', 'H', 'I', 'J', 'K', 'L', 'M',
    'N', 'O', 'P', 'Q', 'R', 'S', 'T', 'U', 'V', 'W', 'X', 'Y', 'Z',
    'a', 'b', 'c', 'd', 'e', 'f', 'g', 'h', 'i', 'j', 'k', 'l', 'm',
    'n', 'o', 'p', 'q', 'r', 's', 't', 'u', 'v', 'w', 'x', 'y', 'z',
    '-', '_', '.', '!', '~', '*','(', ')','!'];

function Escape(const StrEscape: string): string;
type
  TByteChar = record
    case integer of
      0: (a, b: Byte);
      1: (c: WideChar);
  end;
var
  I, P              : integer;
  NeedLen           : integer;
  C                 : WideChar;
  O                 : Word;
  Str               : Widestring;
begin
  str := widestring(StrEscape);
  NeedLen := 0;
  for i := 1 to length(str) do
  begin
    O := ord(str[i]);
    if (O < 128) and (UrlCharType[O] <> 0) then
      inc(NeedLen)
    else if O < 256 then
      Inc(NeedLen, 3)
    else
      Inc(NeedLen, 6);
  end;
  SetLength(Result, NeedLen);
  P := 1;
  for i := 1 to length(str) do
  begin
    C := Str[i];
    O := ord(C);
    if (O < 128) and (UrlCharType[O] <> 0) then
    begin
      Result[P] := Char(str[i]);
      inc(P);
    end
    else if O < 256 then
    begin
      Result[P] := Char('%');
      Result[P + 1] := Char(HexString[O shr 4]);
      Result[P + 2] := Char(HexString[O and $F]);
      inc(P, 3);
    end
    else
    begin
      Result[P] := '%';
      Result[P + 1] := Char('u');
      Result[P + 2] := Char(HexString[TByteChar(c).b shr 4]);
      Result[P + 3] := Char(HexString[TByteChar(c).b and $F]);
      Result[P + 4] := Char(HexString[TByteChar(c).a shr 4]);
      Result[P + 5] := Char(HexString[TByteChar(c).a and $F]);
      inc(P, 6);
    end;
  end;
end;

function UnEscape(const strUnEscape: string): string;
type
  TByteChar = packed record
    case integer of
      0: (a, b: Byte);
      1: (c: WideChar);
  end;
  PByteChar = ^TByteChar;

var
  Str               : Widestring;
  Len, i, j         : integer;
  C                 : Char;
  O                 : Word;
  StrLen            : integer;
  PBC               : PByteChar;
label
  failed;
begin
  SetLength(Str, length(strUnEscape));
  StrLen := length(strUnEscape);
  Len := 0;
  I := 1;
  while i <= StrLen do
  begin
    C := strUnEscape[i];
    O := ord(c);
    if c = '%' then
    begin
      if StrLen - i + 1 < 3 then
        goto failed;
      if strUnEscape[i + 1] = 'u' then
      begin
        if StrLen - i + 1 < 6 then
          goto failed;
        for j := 2 to 5 do
          if not SOCharInSet(strUnEscape[i + j], HexCharSet) then
            goto failed;
        PBC := @Str[len + 1];
        inc(len, 1);
        PBC.b := HexCharToByte(strUnEscape[i + 2]) shl 4 + HexCharToByte(strUnEscape[i + 3]);
        PBC.a := HexCharToByte(strUnEscape[i + 4]) shl 4 + HexCharToByte(strUnEscape[i + 5]);
        Inc(I, 6);
      end
      else
      begin
        for j := 1 to 2 do
          if not SOCharInSet(strUnEscape[i + j], HexCharSet) then
            goto failed;
        PWord(@Str[len + 1])^ := MakeWord(HexCharToByte(strUnEscape[i + 1]) shl 4 + HexCharToByte(strUnEscape[i + 2]), 0);
        inc(len, 1);
        Inc(I, 3);
      end;
    end
    else if (o < 128) and (UrlCharType[O] <> 0) then
    begin
      inc(len);
      Str[len] := widechar(strUnEscape[i]);
      inc(i);
    end
    else
      goto failed;
  end;

  SetLength(str, len);
  Result := string(str);
  Exit;
  failed: result := '';
end;

function jsEncode(const AStr: string; UnEscapeCharSet1,UnEscapeCharSet2: TSoCharSet): string;
var
  Str               : UTF8String;
  I                 : integer;
  Len, StrLen       : integer;
  O                 : Word;
  C                 : Char;
begin
  if AStr = '' then
  begin
    Result := '';
    Exit;
  end;
  Str := UTF8Encode(WideString(AStr));
  StrLen := length(Str);
  SetLength(result, length(str) * 3);
  len := 0;
  I := 1;
  while I <= StrLen do
  begin
    C := char(Str[I]);
    O := ord(C);
    if (O < 128) and (SOCharInSet(C, UnEscapeCharSet1) or SOCharInSet(C, UnEscapeCharSet2)) then
    begin
      Result[len + 1] := C;
      inc(len);
          Inc(I);
      continue;
    end;
    Result[len + 1] := '%';
    Result[len + 2] := HexString[O shr 4];
    Result[len + 3] := HexString[O and $F];
    Inc(len, 3);
    Inc(I);
  end;
  SetLength(Result, len);
end;

function JsDecode(const AStr: string): string;
label
  Failed;
var
  Str               : UTF8String;
  I                 : integer;
  StrLen            : integer;
  len               : integer;
  C                 : Char;
  O                 : integer;
begin
  if AStr = '' then
  begin
    Result := '';
    Exit;
  end;
  SetLength(Str, length(AStr));
  StrLen := length(Astr);
  len := 0;
  I := 1;
  while i <= StrLen do
  begin
    C := AStr[i];
    O := ord(C);
    if O >= 128 then
      goto failed;
    if C <> '%' then
    begin
      Str[len + 1] := Ansichar(C);
      inc(I);
      Inc(len);
      continue;
    end;
    if strlen - i + 1 < 3 then
      goto failed;
    if (not IsHexChar(Astr[i + 1])) or (not IsHexChar(Astr[i + 2])) then
      goto failed;
    PWord(@Str[len + 1])^ := MakeWord(HexCharToByte(Astr[i + 1]) shl 4 + HexCharToByte(Astr[i + 2]), 0);
    inc(I, 3);
    inc(len, 1);
  end;
  SetLength(str, len);
  {$WARNINGS OFF}
  Result := string(UTF8Decode(str));
  {$WARNINGS ON}
  Exit;
  failed: result := '';
end;

function EncodeURI(const Str:string):String;
begin
  result:=jsEncode(Str,js_uriReservedPlusPound_ucstr,js_uriUnescaped_ucstr);
end;

function DecodeURI(const Str:string):String;
begin
  Result:=JsDecode(Str);
end;

function EncodeURIComponent(const str:string):string;
begin
  Result:=jsEncode(str,js_uriUnescaped_ucstr,[]);
end;

function DecodeURIComponent(const str:string):string;
begin
  Result:=JsDecode(str);
end;

end.

